unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, GR32_Image,GR32, ToolWin, ComCtrls,  VSample, VFrames, MMSystem,
  StdCtrls,ImageTrainer, ExtCtrls,GR32_OrdinalMaps, GR32_Filters, CannyEdge, uBlob,
  XPMan;

type
  TFormMain = class(TForm)
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    Image321: TImage32;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ComboBox1: TComboBox;
    Settings1: TMenuItem;
    VideoSize1: TMenuItem;
    VideoSize2: TMenuItem;
    N1: TMenuItem;
    LoadNN1: TMenuItem;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    XPManifest1: TXPManifest;
    ToolButton4: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure VideoSize1Click(Sender: TObject);
    procedure VideoSize2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure LoadNN1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
  private
    { Private declarations }
    fFrameCnt    : integer;
    f30FrameTick : integer;
    VideoImage   : TVideoImage;
    fClosing     : boolean;
    fProcessing  : boolean;
    blob: TBlob;
    trainer: TImageTraner;
    bitmap : TBitmap;
    procedure  CleanPaintBoxVideo;
    procedure initCam;
    procedure OnNewFrame ( var Msg: TMessage ); message WM_NewFrame;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  bmp: TBitmap;
  Data_Points: array[1..20] of TData;
  Finger: array[1..20] of TFinger;
implementation

{$R *.dfm}

procedure TFormMain.CleanPaintBoxVideo;
begin
  Image321.Canvas.Brush.Color := Color;
  Image321.Canvas.rectangle(-1, -1, Image321.Width+1, Image321.Height+1);
end;

procedure TFormMain.OnNewFrame(var Msg: TMessage);
var
  T1 : integer;
//  Counter: SmallInt;
  Bitmap32: TBitmap32;
 // Canny: TCannyEdge;
  dst : TBitmap32;
begin
  Inc ( fFrameCnt );
  if fClosing or fProcessing then exit;
  fProcessing := true;
  try
     VideoImage.OnNewFrame ( Msg );
        if fFrameCnt mod 30 = 0 then begin
          T1 := TimeGetTime;
          if f30FrameTick > 0 then
          StatusBar1.Panels[0].Text:=  'fps: '
                   + FormatFloat ( '0.00', 30000/( T1 - f30FrameTick ));
          f30FrameTick := T1;
        end;

        VideoImage.GetBitmap(bitmap);

        //image321.Bitmap.Assign(bitmap);
        StatusBar1.Panels[1].Text:= IntToStr(Image321.Bitmap.Width)+'x'+
                            IntToStr(Image321.Bitmap.Height);
        FormMain.Width:=Image321.Bitmap.Width  ;
        FormMain.Height:= Image321.Bitmap.Width;


       Timer1.Enabled:= True;
  finally
     fProcessing := false;
 end;
end;
procedure TFormMain.initCam;
var
  SL : TStringList;
begin
  SL := TStringList.Create;
  try
    GetCaptureDeviceList ( SL );
    ComboBox1.Items.Assign ( SL );
  finally
    SL.Free;
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  initCam;
  VideoImage := TVideoImage.Create;
  trainer:= TImageTraner.Create;
  bitmap:= TBitmap.create;
  blob:= TBlob.Create;
  bmp:= TBitmap.Create;

end;

procedure TFormMain.ToolButton1Click(Sender: TObject);
begin
    with ComboBox1 do
    begin
        if VideoImage.VideoStart ( Items [ ItemIndex ] ) <> 0 then begin
            MessageDlg ( 'Error: cannot clip webcam', mtError, [ mbOK ], 0 );
            exit;
        end;
    end;
   // Timer1.Enabled:= True;
end;

procedure TFormMain.VideoSize1Click(Sender: TObject);
begin
  VideoImage.ShowProperty_Stream;
  CleanPaintBoxVideo;
end;

procedure TFormMain.VideoSize2Click(Sender: TObject);
begin
  VideoImage.ShowProperty;
  CleanPaintBoxVideo;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  fClosing := true;
  CanClose := not fProcessing; // Cannot close while image copy action
  if fProcessing then
    PostMessage ( self.Handle, wm_close, 0, 0 )
  else begin
     VideoImage.VideoStop;
     VideoImage.Free;
     Image321.Free;
     trainer.Destroy;
     bitmap.free;
     bmp.Free
  end;
   Application.Terminate;
end;

procedure TFormMain.LoadNN1Click(Sender: TObject);
begin
   if OpenDialog1.Execute then
      trainer.LoadNN(OpenDialog1.FileName);
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
var
  dst, src: TBitmap32;
  map: TIntegerMap;
  i,j: integer;
  Row   : pByteArray;

begin
  bmp.PixelFormat:= pf8bit;
  bmp.Width:= bitmap.Width;
  bmp.Height:= bitmap.Height;
  src:= TBitmap32.Create;
  dst:= TBitmap32.Create;
  dst.SetSize(bitmap.Width, bitmap.Height);
  src.Assign(Bitmap);
  try
       trainer.Guess(src, dst);
       for j:= 0 to bmp.Height-1 do
       begin
           Row := pByteArray(bmp.Scanline[j]);
        for  i := 0 to bmp.Width -1 do
        begin
          row[i] := dst[i,j];
        end;
       end;
       Image321.Bitmap.Assign(bitmap);

       blob.Blob_Detection( bmp,
                       Data_Points);
       blob.Blob_Tracking ( Data_Points,
                      Finger,
                      Image321.Bitmap.Canvas );

  finally
     IF Assigned(src) Then src.Free;
     IF Assigned(dst) Then dst.free;
  end;
end;

procedure TFormMain.ToolButton3Click(Sender: TObject);
begin
 Timer1.Enabled:= False;
 VideoImage.VideoStop;

end;

end.
